home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / system / ifp1s158.zip / PAGE_09.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-17  |  18KB  |  699 lines
  1. unit page_09;
  2.  
  3. interface
  4.  
  5. uses crt, dos, ifpglobl, ifpcomon;
  6.  
  7. procedure page09;
  8.  
  9. implementation
  10.  
  11. procedure page09;
  12.   const
  13.     weekday: array[0..6] of string[9] = ('Sunday', 'Monday', 'Tuesday',
  14.         'Wednesday', 'Thursday', 'Friday', 'Saturday');
  15.  
  16.   var
  17.     foundit, xbool, wasone: boolean;
  18.     xbyte: byte;
  19.     xchar: char;
  20.     xstring1: string;
  21.     xstring2: string;
  22.     xword1: word;
  23.     xword2: word;
  24.     xword3: word;
  25.     xword4: word;
  26.     xword5: word;
  27.     xword6: word;
  28.     xword7: word;
  29.     xword8: word;
  30.     filecount, usedfiles, tablesize: word;
  31.     dt: DateTime;
  32.     s: string;
  33.  
  34.   procedure showecho(a: word);
  35.     var
  36.       xbyte : byte;
  37.  
  38.     begin
  39.     xbyte:=Mem[DOScseg : a];
  40.     case xbyte of
  41.       $00 : Writeln('off');
  42.       $FF : Writeln('on')
  43.     else
  44.       unknown('status', xbyte, 2)
  45.     end
  46.     end; {showecho}
  47.  
  48.   procedure showbufs(a : word);
  49.     const
  50.       bufsmax = 99;
  51.  
  52.     var
  53.       i : 0..bufsmax + 1;
  54.       xbool : boolean;
  55.       xword1 : word;
  56.       xword2 : word;
  57.       xword3 : word;
  58.  
  59.     begin
  60.     if (OSMajor < 4) or (OSMajor >= 10) then
  61.       begin
  62.       i:=0;
  63.       xword1:=MemW[DOScseg : a];
  64.       xword2:=MemW[DOScseg : a + 2];
  65.       xbool:=false;
  66.       repeat
  67.         if i <= bufsmax then
  68.           begin
  69.           if xword1 < $FFFF then
  70.             begin
  71.             inc(i);
  72.             xword3:=xword1;
  73.             xword1:=MemW[xword2 : xword3];
  74.             xword2:=MemW[xword2 : xword3 + 2]
  75.             end
  76.           else
  77.             begin
  78.             xbool:=true;
  79.             Writeln(i)
  80.             end
  81.           end
  82.         else
  83.           begin
  84.           xbool:=true;
  85.           dontknow
  86.           end
  87.       until xbool
  88.       end
  89.     else
  90.       with regs do
  91.         begin
  92.         AX:=$5200;
  93.         MsDos(regs);
  94.         Write(MemW[ES:BX + $3F]:5);
  95.         Caption3('Read-ahead');
  96.         Writeln(MemW[ES:BX + $41]);
  97.         if OSMajor = 4 then
  98.           begin
  99.           Caption3('in EMS');
  100.           xword2:=MemW[ES:BX + $12];
  101.           xword1:=MemW[ES:BX + $14];
  102.           case Mem[xword1: xword2 + $C] of
  103.             $00: Writeln('no');
  104.             $FF: begin
  105.                  Write('yes');
  106.                  Caption3('handle');
  107.                  Writeln(MemW[xword1: xword2 + $D])
  108.                  end;
  109.             $01: if Mem[xword1: xword2 + $18] = 0 then
  110.                    Writeln('no')
  111.                  else
  112.                    begin
  113.                    Write('yes');
  114.                    Caption3('handle');
  115.                    Writeln(MemW[xword1: xword2 + $18])
  116.                    end;
  117.           else
  118.             dontknow
  119.           end; {case}
  120.           end
  121.         end
  122.     end; {showbufs}
  123.     (*  BIX ms.dos/secrets #2  *)
  124.  
  125.   procedure ShowAttrib(s: string; value, mask: byte);
  126.     begin
  127.     if value and mask = mask then
  128.       begin
  129.       if wasone then
  130.         Write('/');
  131.       Write(s);
  132.       wasone:=true
  133.       end;
  134.     end; {ShowAttrib}
  135.  
  136.   begin (* procedure page_09 *)
  137.   Window(1, 3, twidth div 2, tlength - 2);
  138.   Caption2('DOS version');
  139.   with regs do
  140.     begin
  141.     AX:=$4452;
  142.     Flags:=Flags and FCarry;
  143.     MsDos(regs);
  144.     if NoCarry(regs) then
  145.       begin
  146.       Write('DR-DOS ');
  147.       case AX of
  148.         $1063: Writeln('3', decimal, '41');
  149.         $1065: Writeln('5', decimal, '00');
  150.         $1067: Writeln('6', decimal, '00')
  151.       else
  152.         Writeln('? code ', Hex(AX, 4));
  153.       end;
  154.       end
  155.     else
  156.       begin
  157.       if OSMajor >= 10 then
  158.         begin
  159.         Write('OS/2 ', OSMajor div 10, decimal, AddZero(OSMinor));
  160.         Writeln(' DOS session');
  161.         end
  162.       else
  163.         Write(OSMajor, decimal, addzero(OSMinor));
  164.       if (OSMajor < 5) or (OSMajor = 10) then
  165.         Writeln
  166.       else
  167.         begin
  168.         Caption3('revision');
  169.         AX:=$3306;
  170.         MsDos(regs);
  171.         Writeln(Chr((DL and 7) + Ord('A')));
  172.         Caption3('in HMA');
  173.         YesOrNo2(DH and $10 = $10);
  174.         Caption3('in ROM');
  175.         YesOrNo(DH and 8 = 8);
  176.         end;
  177.       end
  178.     end;
  179.   with regs do
  180.     begin
  181.     AX:=$3000;
  182.     MsDos(regs);
  183.     if (AL <> OSMajor) or (AH <> OSMinor) then
  184.       begin
  185.       Caption3('SETVER''d to');
  186.       Write(AL, decimal);
  187.       ZeroPad(AH);
  188.       Writeln
  189.       end
  190.     end;
  191.   Caption2('OEM serial number');
  192.   with regs do
  193.     begin
  194.     AX:=$3000;
  195.     BX:=0;
  196.     MsDos(regs);
  197.     Writeln(Hex(BH, 2))
  198.     end;
  199.   Caption2('System date');
  200.   getdate(xword1, xword2, xword3, xword4);
  201.   if xword4 < 7 then
  202.     Write(weekday[xword4])
  203.   else
  204.     Write('(', Hex(xword4, 4), ')');
  205.   Write(', ');
  206.   xword5:=CBW(Country[0], Country[1]);
  207.   xchar:=Chr(Country[11]);
  208.   case xword5 of
  209.     $0001: Writeln(xword3, xchar, xword2, xchar, xword1);
  210.     $0002: Writeln(xword1, xchar, xword2, xchar, xword3)
  211.   else
  212.     Writeln(xword2, xchar, xword3, xchar, xword1)
  213.   end;
  214.   Caption2('System time');
  215.   gettime(xword1, xword2, xword3, xword4);
  216.   if Country[17] and 1 = 0 then
  217.     case xword1 of
  218.       0: Write('12');
  219.       1..12: ZeroPad(xword1);
  220.       13..23: Write(xword1 - 12)
  221.     end
  222.   else
  223.     ZeroPad(xword1);
  224.   Write(Chr(Country[13]));
  225.   ZeroPad(xword2);
  226.   Write(Chr(Country[13]));
  227.   ZeroPad(xword3);
  228.   Write(decimal);
  229.   ZeroPad(xword4);
  230.   if Country[17] and 1 = 0 then
  231.     if xword1 > 11 then
  232.       Write(' pm')
  233.     else
  234.       Write(' am');
  235.   Writeln;
  236.   Caption2('Command load paragraph');
  237.   Writeln(Hex(PrefixSeg, 4));
  238.   getcbreak(xbool);
  239.   offoron('Ctrl-C check', xbool);
  240.   Writeln;
  241.   getverify(xbool);
  242.   offoron('Disk verify', xbool);
  243.   Writeln;
  244.   Caption2('Switch prefix character');
  245.   Writeln(switchar);
  246.   Caption2('\DEV\ prefix for devices');
  247.   with regs do begin
  248.     AX:=$3702;
  249.     MSDOS(regs);
  250.     if DL = $00 then
  251.       Writeln('required')
  252.     else
  253.       Writeln('optional')
  254.   end;
  255.   Caption2('Reset boot');
  256.   xword1:=MemW[BIOSdseg : $72];
  257.   case xword1 of
  258.     $0000: Writeln('cold');
  259.     $1234, $1200, $EDCB: Writeln('bypass memory test');
  260.     $4321: Writeln('preserve memory');
  261.     $5678: Writeln('system suspended');
  262.     $9ABC{-25924}: Writeln('manufacturing test mode'); (*!$9ABC*)
  263.     $ABCD{-21555}: Writeln('system POST loop mode') (*!$ABCD*)
  264.   else
  265.     unknown('flag', xword1, 4)
  266.   end;
  267.   Caption2('Boot disk was');
  268.   if OSMajor >= 4 then
  269.     with regs do
  270.       begin
  271.       AX:=$3305;
  272.       MsDos(regs);
  273.       Writeln(Chr(DL+$40), ':')
  274.       end
  275.   else
  276.     dontknow;
  277. (*  Byte 12:12 p.178  *)
  278.   with regs do begin
  279.     Caption2('DOS critical flag');
  280.     AX:=$5D06;
  281.     MSDOS(regs);
  282.     segofs(DS, SI);
  283.     Writeln
  284.   end;
  285.   Caption2('DOS busy flag    ');
  286.   segofs(DOScseg, DOScofs);
  287.   Writeln;
  288.   Caption2('Printer echo');
  289.   case OSMajor of
  290.     3 : case OSMinor div 10 of
  291.       0 : dontknow;
  292.       1..3 : showecho($02AC)
  293.       else
  294.         dontknow
  295.     end;
  296.       4,5,6 : showecho($02FE);
  297.   else
  298.       dontknow
  299.   end;
  300. (*  BIX ms.dos/secrets #501  *)
  301.   Caption2('PrtSc status');
  302.   xbyte:=Mem[BIOSdseg : $0100];
  303.   case xbyte of
  304.     $00 : Writeln('ready');
  305.     $01 : Writeln('busy');
  306.     $FF : Writeln('error on last PrtSc')
  307.     else
  308.       unknown('status', xbyte, 2)
  309.   end;
  310.   Caption2('Memory allocation');
  311.   with regs do begin
  312.     AX:=$5800;
  313.     MSDOS(regs);
  314.     case AL of
  315.       0: Writeln('first fit');
  316.       1: Writeln('best fit');
  317.       2..$3F,$43..$7F,$83..$FF: Writeln('last fit');
  318.       $40: Writeln('hi mem first fit');
  319.       $41: Writeln('hi mem best fit');
  320.       $42: Writeln('hi mem last fit');
  321.       $80: Writeln('frst fit,hi then low');
  322.       $81: Writeln('best fit,hi then low');
  323.       $82: Writeln('last fit,hi then low');
  324.     else
  325.       dontknow
  326.     end
  327.   end;
  328.   Caption2('DOS buffers');
  329.   case OSMajor of
  330.     3 : case OSMinor div 10 of
  331.           0 : showbufs($013F);
  332.           1..3 : showbufs($0038)
  333.         else
  334.           dontknow
  335.         end;
  336.     4,5,6 : showbufs(0)
  337.   else
  338.     dontknow
  339.   end;
  340.   Caption2('File handle table ');
  341.   xword1:=MemW[PrefixSeg : $0036];
  342.   xword2:=MemW[PrefixSeg : $0034];
  343.   SegOfs(xword1, xword2);
  344.   W